home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / KEYBOARD.SWG / 0078_Key Input Unit.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-26  |  13KB  |  344 lines
  1. UNIT KeyInput;
  2.  
  3. INTERFACE
  4.  
  5. USES CRT,           {Import Sound function}
  6.      CURSOR;        {Import ChangeCursor}
  7.  
  8. CONST
  9.    StandardInput = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUV'
  10.                   +'WXYZ1234567890~!@#$%^&*()-+\[]{};:`''".,/<> =_?|';
  11.    HighBitInput  = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUV'
  12.                   +'WXYZ1234567890~!@#$%^&*()-+\[]{};:`''".,/<> =_?|'
  13.                   +'ÇüéâäàåçêëèïîìÄÅÉæÆôöòûùÿÖÜ¢£¥₧ƒáíóúñѪº¿⌐¬½¼¡«'
  14.                   +'»░▒▓│┤╡╢║╕╣║╗╝╜╛┐└┴┬├─┼╞╟╚╔╩╦╠═╬╧╨╤╥╙╘╒╓╫╪┘┌█▄▌▐'
  15.                   +'▀αßΓ
  16. ΣσµτΦΘΩδ∞φε∩≡±≥≤⌠⌡÷≈°∙·√ⁿ²■';
  17.    FilenameInput = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUV'
  18.                   +'WXYZ1234567890~!@#$%^&()-_{}.';
  19.    FilespecInput = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUV'
  20.                   +'WXYZ1234567890~!@#$%^&()-_{}.?*';
  21.    FilepathInput = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUV'
  22.                   +'WXYZ1234567890~!@#$%^&()-_{}.?*:\';
  23.    NumberInput   = '123456790.-+';
  24.  
  25.    BackSpace = #8;
  26.    Space = ' ';
  27.  
  28.  
  29. TYPE
  30.    TInput = (Standard,HighBit,Filename,Filespec,Filepath,Number);
  31.  
  32.  
  33. VAR
  34.    MaskCh: Char; {must be set before using}
  35.  
  36.  
  37. PROCEDURE GetInput(VAR InStr;           (* Variable being edited *)
  38.                    WhatWas: String;     (* "Old" Value -- being edited *)
  39.                    InputType: TInput;   (* Input type -- from TInput *)
  40.                    Len,                 (* Maximum Characters *)
  41.                    XPos,                (* X Start Position *)
  42.                    YPos,                (* Y Start Position *)
  43.                    Attr,                (* Text Attribute while editing *)
  44.                    HighLightAttr: Byte; (* Attribute of Highlighted Text *)
  45.                    BackCh: Char;        (* Background Character *)
  46.                    MaskInput,           (* Masked Input? -- Set "MaskCh" *)
  47.                    Caps: Boolean);      (* Force CAPS? *)
  48.  
  49.  
  50. IMPLEMENTATION
  51.  
  52.  
  53. PROCEDURE MY_Delay(MS: Word); Assembler;
  54.    (* My Delay procedure, used instead of TP6.0's Delay procedure *)
  55.  
  56. ASM
  57.    MOV Ax, 1000;
  58.    MUL MS;
  59.    MOV Cx, Dx;
  60.    MOV Dx, Ax;
  61.    MOV Ah, $86;
  62.    INT $15;
  63. END;
  64.  
  65.  
  66. PROCEDURE GetInput(VAR InStr;
  67.                    WhatWas: String;
  68.                    InputType: TInput;
  69.                    Len,
  70.                    XPos,
  71.                    YPos,
  72.                    Attr,
  73.                    HighLightAttr: Byte;
  74.                    BackCh: Char;
  75.                    MaskInput,
  76.                    Caps: Boolean);
  77.  
  78. TYPE
  79.    TInsert = (On,Off); (* Insert On/Off Type *)
  80.  
  81. VAR
  82.    Temp: String;                      (* Temporary String Holder *)
  83.    Ch: Char;                          (* Reads Characters *)
  84.    A, B, U: Byte;                     (* Counters *)
  85.    ValidKey,                          (* Whether is valid key *)
  86.    FirstChar,                         (* Whether is first char entered *)
  87.    InsertOn,                          (* Insert or overstrike mode *)
  88.    NoAdd: Boolean;                    (* Whether to add key to string *)
  89.    NewString: String ABSOLUTE InStr;  (* String being edited *)
  90.  
  91.  
  92.    PROCEDURE Ding;
  93.       (* Makes sound to tell user invalid key was pressed *)
  94.  
  95.    BEGIN
  96.       Sound(300);
  97.       MY_Delay(30);
  98.       NoSound;
  99.    END;
  100.  
  101.  
  102.    PROCEDURE ToggleInsert(Ins: TInsert);
  103.       (* Toggles Insert/Overstrike Mode via TInsert type *)
  104.  
  105.    BEGIN
  106.       IF Ins = On THEN
  107.        BEGIN
  108.           InsertOn := TRUE;
  109.           ChangeCursor(NormCursor);
  110.        END
  111.       ELSE
  112.        BEGIN
  113.           InsertOn := FALSE;
  114.           ChangeCursor(BlockCursor);
  115.        END;
  116.    END;
  117.  
  118.  
  119.    PROCEDURE FlushKBuff;
  120.       (* Flush keyboard buffer *)
  121.    VAR Flush: Char;
  122.  
  123.    BEGIN
  124.       WHILE KeyPressed DO Flush := Readkey;
  125.    END;
  126.  
  127.  
  128. BEGIN
  129.    ChangeCursor(NormCursor); (* Default to normal cursor *)
  130.    InsertOn := TRUE;         (* Default to Insert Mode *)
  131.    FirstChar := TRUE;        (* Set to first character being entered *)
  132.    NewString := '';          (* Null NewString *)
  133.    Temp := '';               (* Null Temporary String *)
  134.    GotoXY(XPos,YPos);
  135.    TextAttr := Attr;
  136.    FOR U := 1 TO Len DO Write(BackCh);
  137.    GotoXY(XPos,YPos);
  138.    FlushKBuff;
  139.    Ch := #0;
  140.    TextAttr := HighLightAttr;
  141.    NewString := WhatWas;
  142.    IF MaskInput THEN FOR U := 1 TO Length(NewString) DO Write(MaskCh)
  143.    ELSE Write(NewString);
  144.    B := Length(WhatWas);
  145.    A := B;
  146.       (* "A" Counter = How many characters are in string *)
  147.       (* "B" Counter = Current cursor placement in string *)
  148.    TextAttr := Attr;
  149.    WHILE (Ch <> #13) AND (Ch <> #27) DO
  150.     BEGIN
  151.        NoAdd := FALSE;    (* Default to add key to string *)
  152.        ValidKey := FALSE; (* Default to invalid key unless proven valid *)
  153.        IF Caps THEN Ch := UpCase(ReadKey)
  154.        ELSE Ch := ReadKey;
  155.        CASE InputType OF (* Check if Ch is in the input list *)
  156.           Standard: IF (POS(Ch,StandardInput) > 0) OR
  157.                        (Ch IN [#13,#27,#0,#8,#25]) THEN ValidKey := TRUE;
  158.           HighBit : IF (POS(Ch,HighBitInput) > 0) OR
  159.                        (Ch IN [#13,#27,#0,#8,#25]) THEN ValidKey := TRUE;
  160.           Filename: IF (POS(Ch,FilenameInput) > 0) OR
  161.                        (Ch IN [#13,#27,#0,#8,#25]) THEN ValidKey := TRUE;
  162.           Filespec: IF (POS(Ch,FilespecInput) > 0) OR
  163.                        (Ch IN [#13,#27,#0,#8,#25]) THEN ValidKey := TRUE;
  164.           Filepath: IF (POS(Ch,FilepathInput) > 0) OR
  165.                        (Ch IN [#13,#27,#0,#8,#25]) THEN ValidKey := TRUE;
  166.           Number  : IF (POS(Ch,NumberInput) > 0) OR
  167.                        (Ch IN [#13,#27,#0,#8,#25]) THEN ValidKey := TRUE;
  168.        END;
  169.        IF ValidKey THEN
  170.         BEGIN
  171.            CASE Ch OF
  172.               #0 : BEGIN
  173.                       NoAdd := TRUE;
  174.                       IF FirstChar THEN
  175.                        BEGIN
  176.                           FirstChar := FALSE;
  177.                           GotoXY(XPos,YPos);
  178.                           IF MaskInput THEN FOR U := 1 TO Length(NewString) DO Write(MaskCh)
  179.                           ELSE Write(NewString);
  180.                        END;
  181.                       Ch := UpCase(ReadKey);
  182.                       CASE Ch OF
  183.                          #77: IF B <= Length(NewString)-1 THEN {Right Arrow}
  184.                                BEGIN
  185.                                   GotoXY(XPos+B+1,YPos);
  186.                                   Inc(B);
  187.                                END
  188.                               ELSE Ding;
  189.                          #75: IF B >= 1 THEN {Left Arrow}
  190.                                BEGIN
  191.                                   GotoXY(XPos+B-1,YPos);
  192.                                   Dec(B);
  193.                                END
  194.                               ELSE Ding;
  195.                          #71: BEGIN {Home}
  196.                                  GotoXY(XPos,YPos);
  197.                                  B := 0;
  198.                               END;
  199.                          #79: BEGIN {End}
  200.                                  GotoXY(XPos+Length(NewString),YPos);
  201.                                  B := Length(NewString);
  202.                               END;
  203.                          #82: IF InsertOn THEN ToggleInsert(Off) {Ins}
  204.                               ELSE ToggleInsert(On);
  205.                          #83: BEGIN {Del}
  206.                                  IF (B < Length(NewString)) AND (B >= 0) THEN
  207.                                   BEGIN
  208.                                      Delete(NewString,B+1,1);
  209.                                      FOR U := B TO Length(NewString) DO
  210.                                       IF MaskInput THEN
  211.                                        BEGIN
  212.                                           IF U <> B THEN Temp := Temp + MaskCh
  213.                                           ELSE Temp := '';
  214.                                        END
  215.                                       ELSE
  216.                                        BEGIN
  217.                                           IF U <> B THEN Temp := Temp + NewString[U]
  218.                                           ELSE Temp := '';
  219.                                        END;
  220.                                      GotoXY(XPos+B,YPos);
  221.                                      Write(Temp);
  222.                                      Write(BackCh);
  223.                                      GotoXY(XPos+B,YPos);
  224.                                      Dec(A);
  225.                                   END;
  226.                               END;
  227.                          ELSE Ding;
  228.                       END;
  229.                       FlushKBuff;
  230.                    END;
  231.               #8 : IF B >= 1 THEN {Backspace}
  232.                     BEGIN
  233.                        IF FirstChar THEN
  234.                         BEGIN
  235.                            FirstChar := FALSE;
  236.                            GotoXY(XPos,YPos);
  237.                            IF MaskInput THEN FOR U := 1 TO Length(NewString) DO Write(MaskCh)
  238.                            ELSE Write(NewString);
  239.                         END;
  240.                        Delete(NewString,B,1);
  241.                        Write(Backspace,BackCh,Backspace);
  242.                        Dec(B);
  243.                        Dec(A);
  244.                        GotoXY(XPos+B,YPos);
  245.                        FOR U := B TO Length(NewString) DO
  246.                         IF MaskInput THEN
  247.                          BEGIN
  248.                             IF B <> U THEN Temp := Temp + MaskCh
  249.                             ELSE Temp := '';
  250.                          END
  251.                         ELSE
  252.                          BEGIN
  253.                             IF B <> U THEN Temp := Temp + NewString[U]
  254.                             ELSE Temp := '';
  255.                          END;
  256.                        Write(Temp);
  257.                        FOR U := Length(NewString)+1 TO Len DO Write(BackCh);
  258.                        GotoXY(XPos+B,YPos);
  259.                        NoAdd := TRUE;
  260.                     END
  261.                    ELSE Ding;
  262.               #27: BEGIN {Esc}
  263.                       NoAdd := TRUE;
  264.                       NewString := WhatWas;
  265.                    END;
  266.               #25: BEGIN {CTRL+Y}
  267.                       NoAdd := TRUE;
  268.                       NewString := '';
  269.                       GotoXY(XPos,YPos);
  270.                       FOR U := 1 TO Len DO Write(BackCh);
  271.                       FirstChar := FALSE;
  272.                       GotoXY(XPos,YPos);
  273.                       B := 0;
  274.                       A := 0;
  275.                    END;
  276.               #13: NoAdd := TRUE;
  277.            END;
  278.            IF (((A < Len) OR ((A < Len+1) AND NOT(InsertOn))) AND (NoAdd = FALSE)
  279.               AND (Ch <> #8)) OR ((FirstChar) AND (NOT(NoAdd)) AND (Ch <> #8)) THEN
  280.             BEGIN
  281.                IF FirstChar THEN
  282.                 BEGIN
  283.                    NewString := '';
  284.                    GotoXY(XPos,YPos);
  285.                    B := 0;
  286.                    A := 0;
  287.                    FOR U := 1 TO Len Do Write(BackCh);
  288.                    GotoXY(XPos,YPos);
  289.                    FirstChar := FALSE;
  290.                 END;
  291.                IF InsertOn THEN
  292.                 BEGIN
  293.                    Inc(B);
  294.                    Inc(A);
  295.                    Insert(Ch,NewString,B);
  296.                    FOR U := B TO Length(NewString) DO
  297.                     IF MaskInput THEN
  298.                      BEGIN
  299.                         IF B <> U THEN Temp := Temp + MaskCh
  300.                         ELSE Temp := '';
  301.                      END
  302.                     ELSE
  303.                      BEGIN
  304.                         IF B <> U THEN Temp := Temp + NewString[U]
  305.                         ELSE Temp := '';
  306.                      END;
  307.                    GotoXY(XPos+B-1,YPos);
  308.                    IF MaskInput THEN Write(MaskCh)
  309.                    ELSE Write(Ch);
  310.                    Write(Temp);
  311.                    GotoXY(XPos+B,YPos);
  312.                 END
  313.                ELSE
  314.                 BEGIN
  315.                    IF Length(NewString) < Len THEN
  316.                     BEGIN
  317.                        IF B >= Length(NewString) THEN Inc(A);
  318.                        Inc(B);
  319.                        Delete(NewString,B,1);
  320.                        Insert(Ch,NewString,B);
  321.                        IF MaskInput THEN Write(MaskCh)
  322.                        ELSE Write(Ch);
  323.                     END
  324.                    ELSE IF (A = Len) AND (B < Len) THEN
  325.                     BEGIN
  326.                        Inc(B);
  327.                        Delete(NewString,B,1);
  328.                        Insert(Ch,NewString,B);
  329.                        IF MaskInput THEN Write(MaskCh)
  330.                        ELSE Write(Ch);
  331.                     END;
  332.                 END;
  333.             END;
  334.         END
  335.        ELSE Ding;
  336.     END;
  337.    FlushKBuff;
  338.    ChangeCursor(NormCursor);
  339. END;
  340.  
  341.  
  342. END.
  343.  
  344.